home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / comcorn / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-12  |  2.3 KB  |  97 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   ComObj, ActiveX, AxDocs, Menus, ComCtrls, DAXDoc_TLB;
  7.  
  8. type
  9.   TDelphiAxDoc = class(TActiveXDocument, IDelphiAxDoc, IPersistStreamInit)
  10.   private
  11.     FItem: TMenuItem;
  12.     FSubItem: TMenuItem;
  13.   protected
  14.     { IPersistStreamInit }
  15.     function IPersistStreamInit.Load = PersistStreamLoad;
  16.     function IPersistStreamInit.Save = PersistStreamSave;
  17.     function IsDirty: HResult; stdcall;
  18.     { Override TActiveXControl streaming mechanism to simply use memo lines }
  19.     procedure LoadFromStream(const Stream: IStream); override;
  20.     procedure SaveToStream(const Stream: IStream); override;
  21.   public
  22.     destructor Destroy; override;
  23.     procedure DoMenuClick(Sender: TObject);
  24.     procedure Initialize; override;
  25.   end;
  26.  
  27. implementation
  28.  
  29. uses ComServ, StdCtrls, MainForm, AxCtrls, Windows, Dialogs;
  30.  
  31. { TDelphiAxDoc }
  32.  
  33. destructor TDelphiAxDoc.Destroy;
  34. begin
  35.   inherited Destroy;
  36.   FSubItem.Free;
  37.   FItem.Free;
  38. end;
  39.  
  40. procedure TDelphiAxDoc.DoMenuClick(Sender: TObject);
  41. begin
  42.   with TColorDialog.Create(nil) do
  43.   begin
  44.     if Execute then (Control as TMemo).Color := Color;
  45.     Free;
  46.   end;
  47. end;
  48.  
  49. procedure TDelphiAxDoc.Initialize;
  50. begin
  51.   inherited Initialize;
  52.   FItem := NewItem('&Change color', 0, False, True, DoMenuClick, 0, 'ColorItem');
  53.   FSubItem := NewSubMenu('&Edit', 0, 'EditItem', [FItem]);
  54.   Menu := NewMenu(Control, 'MainMenu', [FSubItem]);
  55. end;
  56.  
  57. procedure TDelphiAxDoc.LoadFromStream(const Stream: IStream);
  58. var
  59.   OS: TOleStream;
  60. begin
  61.   OS := TOleStream.Create(Stream);
  62.   try
  63.     (Control as TMemo).Lines.SaveToStream(OS);
  64.   finally
  65.     OS.Free;
  66.   end;
  67. end;
  68.  
  69. procedure TDelphiAxDoc.SaveToStream(const Stream: IStream);
  70. var
  71.   OS: TOleStream;
  72.   Memo: TMemo;
  73. begin
  74.   OS := TOleStream.Create(Stream);
  75.   try
  76.     Memo := Control as TMemo;
  77.     Memo.Lines.LoadFromStream(OS);
  78.     Memo.Modified := False;
  79.   finally
  80.     OS.Free;
  81.   end;
  82. end;
  83.  
  84. { TDelphiAxDoc.IPersistStreamInit }
  85.  
  86. function TDelphiAxDoc.IsDirty: HResult;
  87. begin
  88.   if (Control as TMemo).Modified then Result := S_OK
  89.   else Result := S_FALSE;
  90. end;
  91.  
  92. initialization
  93.   TActiveXDocumentFactory.Create(ComServer, TDelphiAxDoc, TMemo,
  94.     Class_DelphiAxDoc, 0, 131473, tmApartment, '', 8 {DOCMISC_NOFILESUPPORT});
  95. finalization
  96. end.
  97.